Attribute VB_Name = "modSplitMultiDelims"
Option Explicit


Sub SplitMultiDelims_TEST()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SplitMultiDelims_TEST
' This tests the SplitMultiDelims functions. Valid delimiters
' are in the constant C_DELIM_CHARS and it splits the single
' string S into its componenets.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const C_DELIM_CHARS = "|:,;" ' for example
Dim Arr() As String
Dim S As String
Dim N As Long

S = "a|bc;def:ghij;klmno|"

Arr = SplitMultiDelims(Text:=S, DelimChars:=C_DELIM_CHARS)
If IsArrayAllocated(Arr) = True Then
    For N = LBound(Arr) To UBound(Arr)
        Debug.Print Arr(N)
    Next N
End If


End Sub

Sub SplitMultiDelimsEX_TEST()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SplitMultiDelimsEX_TEST
' This tests the SplitMultiDelimsEX function. The
' DelimiterStringSeparator character delimits the delimiter
' strings in DelimiterStrings.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim Arr() As String
Dim S As String
Dim N As Long
Dim DelimeterStringSeparator As String
Dim DelimiterStrings As String
Dim TestString As String
DelimeterStringSeparator = Chr(1) ' this must NOT be a regular delimiter character or string

DelimiterStrings = "END" & DelimeterStringSeparator & "STOP" & DelimeterStringSeparator & "DROP"

TestString = "aENDbcSTOPdefENDghijDROPklmnoSTOP"



Arr = SplitMultiDelimsEX(Text:=TestString, DelimStrings:=DelimiterStrings, DelimStringsSep:=DelimeterStringSeparator)
If IsArrayAllocated(Arr) = True Then
    For N = LBound(Arr) To UBound(Arr)
        Debug.Print Arr(N)
    Next N
End If


End Sub


Function SplitMultiDelims(Text As String, DelimChars As String) As String()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SplitMutliChar
' This function splits Text into an array of substrings, each substring
' delimited by any character in DelimChars. Only a single character
' may be a delimiter between two substrings, but DelimChars may
' contain any number of delimiter characters. If you need multiple
' character delimiters, use the SplitMultiDelimsEX function. It returns
' an unallocated array it Text is empty, a single element array
' containing all of text if DelimChars is empty, or a 1 or greater
' element array if the Text is successfully split into substrings.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Pos1 As Long
Dim N As Long
Dim M As Long
Dim Arr() As String
Dim I As Long

''''''''''''''''''''''''''''''''
' if Text is empty, get out
''''''''''''''''''''''''''''''''
If Len(Text) = 0 Then
    Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''
' if DelimChars is empty, return original text
''''''''''''''''''''''''''''''''''''''''''''''
If DelimChars = vbNullString Then
    SplitMultiDelims = Array(Text)
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''''''''''''
' oversize the array, we'll shrink it later so
' we don't need to use Redim Preserve
'''''''''''''''''''''''''''''''''''''''''''''''
ReDim Arr(1 To Len(Text))

I = 0
N = 0
Pos1 = 1

For N = 1 To Len(Text)
    For M = 1 To Len(DelimChars)
        If StrComp(Mid(Text, N, 1), Mid(DelimChars, M, 1), vbTextCompare) = 0 Then
            I = I + 1
            Arr(I) = Mid(Text, Pos1, N - Pos1)
            Pos1 = N + 1
            N = N + 1
        End If
    Next M
Next N

If Pos1 <= Len(Text) Then
    I = I + 1
    Arr(I) = Mid(Text, Pos1)
End If

''''''''''''''''''''''''''''''''''''''
' chop off unused array elements
''''''''''''''''''''''''''''''''''''''
ReDim Preserve Arr(1 To I)
SplitMultiDelims = Arr
    
End Function


Function SplitMultiDelimsEX(Text As String, DelimStrings As String, _
    DelimStringsSep As String) As String()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SplitMultiDelimsEX
' This function is like VBA's Split function or the SplitMultiDelims
' function, also in this module. It accepts any number of multiple-
' character delimiter strings and splits Text into substrings based
' on the delimiter strings. It returns an unallocated array if Text
' is empty, a single-element array if DelimStrings is empty, or a
' 1 or greater element array if Text was successfully split into
' substrings based on the DelimStrings delimiters.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Pos1 As Long
Dim N As Long
Dim M As Long
Dim Arr() As String
Dim I As Long
Dim DelimWords() As String
Dim DelimNdx As Long
Dim DelimWord As String

'''''''''''''''''''''''''''''
' if Text is empty, get out
'''''''''''''''''''''''''''''
If Len(Text) = 0 Then
    Exit Function
End If

'''''''''''''''''''''''''''''''''''''''''''''''''''
' if there are no delimiters, return the whole text
'''''''''''''''''''''''''''''''''''''''''''''''''''
If DelimStrings = vbNullString Then
    SplitMultiDelimsEX = Array(Text)
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''
' if there is no delim separator, get out
''''''''''''''''''''''''''''''''''''''''''
If DelimStringsSep = vbNullString Then
    Exit Function
End If

DelimWords = Split(DelimStrings, DelimStringsSep)
If IsArrayAllocated(DelimWords) = False Then
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''
' oversize the array, we'll shrink it later so
' we don't need to use Redim Preserve
''''''''''''''''''''''''''''''''''''''''''''''''
ReDim Arr(1 To Len(Text))

I = 0
N = 0
Pos1 = 1

For N = Pos1 To Len(Text)
    For DelimNdx = LBound(DelimWords) To UBound(DelimWords)
        DelimWord = DelimWords(DelimNdx)
        If StrComp(Mid(Text, N, Len(DelimWord)), DelimWord, vbBinaryCompare) = 0 Then
            I = I + 1
            Arr(I) = Mid(Text, Pos1, N - Pos1)
            Pos1 = N + Len(DelimWord)
            N = Pos1
        End If
    Next DelimNdx
Next N

If Pos1 <= Len(Text) Then
    I = I + 1
    Arr(I) = Mid(Text, Pos1)
End If

''''''''''''''''''''''''''''''''''''
' chop off unused array elements
''''''''''''''''''''''''''''''''''''
ReDim Preserve Arr(1 To I)
SplitMultiDelimsEX = Arr
    
End Function






Private Function IsArrayAllocated(Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayAllocated
' Returns True or False indicating whether a dynamic
' array is allocated. It supports arrays that are the
' result of functions like Split in which case the
' LBound is greater than the UBound for unallocated
' arrays.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    IsArrayAllocated = (IsArray(Arr) = True) And _
                    (IsError(LBound(Arr, 1)) = False) And _
                    (LBound(Arr, 1) <= (UBound(Arr, 1)))
                    
End Function


Sub AAA()
Dim S As String

S = "abc33def66ghi"
Dim V As Variant
V = Split(S, Array("33", "66"))
Debug.Print V(0), V(1)





End Sub
